perm filename TESTX[E,ALS] blob sn#191995 filedate 1975-12-12 generic text, type T, neo UTF8
;E -- DISPLAY EDITOR FOR STANFORD
;Written by Frederick H.G. Wright II 
;with modifications by D. Poole, Art Samuel, Stan Kugell, and Martin Frost.
;The Essay program was contracted by John Mccarthy and written by Stan Kugell

;PRINTS /Type 0 to get ETV, 1 to get ESSAY, then <CTRL><META><LF>./
;ESSFLG←←.INSER TTY:
IFNDEF ESSFLG<ESSFLG←0>

IFE ESSFLG<TITLE ETV -- DISPLAY EDITOR FOR STANFORD↔SUBTTL FREDERICK H.G. WRIGHT II
PRINTS /       You are assembling ETV, the Stanford Display Editor
/
PRINTS⊗	Sep.30	E.64(p581)	OCT. 9	E.65(P584)	Oct.17	E.66(P597)
	Nov.9	E.67(P601) 	Nov.13	E.68(P605)	Nov.21	E.69

see E.68, E.66 and E.52 for details as to changes in earlier versions
Note that E.52 and all that follow use and requires new PTL7W9 on system 7.01 T.
 If backing up to system before this one must use E.51.
E.68
 Bug fixed that caused substitute ended with αβ\ to substitute for 2nd occurrence.
 Automatic directory extension put up on 9-Nov-75.
 Spool command changed to spool attach buffer. Up 11/13/75 AM.
E.69
 Default starting page for extended files is first new page, if any, else normal.
 Automatic deletion of .MSG[2,2] file whose last msg is deleted with ∂ command.
 Fix to the very old INVALID DIRECTORY POINTER bug.
 "U" to appear on top line if directory needs to be updated.
 Meta-CR at end of line fixed to add following blank line instead of preceding one.
 Screen not erased at initialization if type-ahead is present.
 XUPDATE command to force out updated directory; illegal in READONLY mode.
 ERR.001, ERR.ME1, and ERR.ALS up Nov 19th 8:45.
 Fix to rippling code to avoid adding garbage to file if it doesn't end on record.
 Changes to trailer line to show R value always with + or - C or B or X values.
 UP 8:37 11/21/75
 Protection 400  bit note shows at file enter time.
 XPROTEC command in. See note in E.ALS for details.
 Change in file switching with more than 8 files to cause the least recent
referece number to be assigned to the new file.
e.70
 Better recovery from protection failure on protection RENAME.  Fix for system bug.
 RAID flushed from system's upper segment.
 .POX added to default extension list.
 Up 10/11/75
 Default entry to ? changed to page 2.
 Upper segment called ERAID when has RAID.
 Fix to multi-page search to understand EOF in middle of record.
 MAIL, SEND, and REMIND eXtended commands.
⊗>

IFN ESSFLG<TITLE ESSAY
PRINTS /       You are assembling Essay.
/>
DEFINE ESSAY <IFN ESSFLG>
DEFINE NOESS <IFE ESSFLG>

COMMENT ⊗ TO PUT UP A NEW E WITH AN UPPER SEGMENT, USE THE COMMANDS:

.LOA %SE%1<%V%1B	;LOADS WITH SYMBOLS AND RAID IN THE UPPER SEGMENT
.S 137			;RENAMES UPPER, WRITE PROTECTS AND SETS ITS PROTECTION CONSTANT
.SSAVE SYS E		;BE SURE TO SSave (to keep the UPPER SEGMENT around)

DATA STRUCTURE.
	A page  of text is  represented in memory  as a theaded  list of
items  each representing a  single line of  the text. Each  item in this
representation contains four  words of header  information, the text  of
the line in question and one trailer word.
	The first header word contains a TXTCOD, which for ordinary text
is a 2 in the left half and the total number of words in the right half. 
This word  is used  by the  free storage  management routines, and  only
rarely by the text manipulation sections of the code.  The word count is
duplicated in the  trailer word which is  used only by the  free storage
routines.
	The  second  header  word is  a  pointer word.    It  contains a
backward pointer  in  the left  half  pointing to  the location  of  the
pointer  word of  the previous  item  and in  the right  half  a forward
pointer to  the location  of the  pointer  word of  the next  item.  The
location of the pointer word for the first item is contained in the word
at  PAGE and  the  backward pointer  for the  first item points  back to
PAGE. The last item on the page points to the word BOTSTR and  this word
points back to this last item and forward to itself.  When in the ATTACH
mode,   the  location  ATTBUF points  to the pointer  word of  the first
attached line and back to the pointer word of the last attached line.
	The third word contains  flag bits in the left  half identifying
the type  of the line and two  9-bit bytes in the right  half. Flag bits
which have been identified are:
	400000	 the line is a page mark.
	200000	 the line is ARRLIN (CURRENT to which the arrow points).
	100000	 the line is WINLIN (the first line on the window).
	040000   the line is an Essay reference (for the ESSAY version).
The  first byte  in  the right  half  contains the  total  count of  the
characters as the line is stored on the disk, where a TAB symbol counts
1 and the terminating CR and LF are counted.
The  second byte  contains  the  count of  the  characters as  they  are
displayed where a TAB is counted as the number of spaces it produces and
the terminating CR and LF are not counted. 

	The fourth word is the serial number of the line as kept in the
core. This number is changed every time that a change is made to the line
so this number then bears no relationship to the position of the line on
the page.

	The text occupies an integral number of words and is  padded out
with nulls.
	The trailer  word contains the count  of the total words  in the
item,   including  header   and  trailer  words.   This  duplicates  the
information in the right half of the first header word.

       TABs are handled in a pecular way. When a TAB occurs it is stored
as  a TAB and  this is  followed by as  many spaces  as the TAB  in fact
produces in the text and then by a terminating TAB.

Dispatch tables are used to handle commands and for character dispatching.
A list of these follows. DSP is used as the index register for references
to these tables.  This reference is often indirect,- example XCT @CTAB(C)
will be directed to a command indexed by DSP.

	Page	Page
Table	Init.ed	on 	Usage			Unusual features

DELDSP	27	27	CONTROL D command
EDDSP	45	45	Editing
EDGDSP	47	48	Editing
CMDSP	48	16	Main command loop
CDDSP	99	99	Check directory
CPDSP	102	103	Check page
XDRDSP	112	112	Extending directory	Uses B as flag for doing dir line
GDDSP	110	113	Get directory
SKPDSP	117	117	In NEWDIR routine
MD1DSP	118	119	Make directory
MD2DSP	119	120	Make directory
MDCRCK	121	121
MDLFCK	120	121
RPDSP	127	126	Read page		Contains JUMPGE T,  entries
RPDSP2	127	126	Pseudo FF in Read page
DGDSP	131
ODDSP	133	133
IDDSP	134
WRDSP	165		Write page
SSCDSP	181
GBPDSP	213	213
JDISP	225	217	Justify
JNDISP	225	217
JDISP	225	217
JDISP2	222	222
JADISP	222
XWRDAP	234	234	Spooling
       end of comment ⊗

NOLIT

;Register	Most common usage

F←0		;Flag bits
A←1		;Argument value
B←2		;CONTROL and META bits as stripped from command character.
C←3		;Character
D←4		;Dispatch table entry
E←5		;Table location.
G←6
H←7
I←10
DSP←11		;Dispatch table location (CTAB most of the time).
Q←14
T←15
TT←16
P←17		;Always reserved as PDL pointer.

DEFINE STOPJ
	{PUSHJ P,STOPJC	
	}	
;Used to replace JRST 4,. and other fatal halts to inform ALS of trouble
;STOPJ USED FOR JRST 4,. terminating with a JRST 4,. as usual
;STOPC used for JRST 4,. WHEN ATTEMPT IS MADE TO CONTINUE

IFNDEF PURESW<PURESW←←1>	;DEFAULT TO SHARABLE PURE UPPER SEGMENT
IFNDEF DEBSW<DEBSW←←1>
IFNDEF BOOKMD<BOOKMD←←1>
;BOOKMD NON-ZERO PERMITS /B MODE FOR READING BOOKS.  0 DISABLES /B MODE.

COPNUM←←3	;LOG OF # K OF CORE FOR TEMP COPY BUFFER
SRSIZ←←40	;SIZE OF SEARCH STRING BUFFER
LPDL←←69
DPYBSZ←←=660*2

DSKI←←1
DSKO←←2
DSKSP←←4	;Used for spooling file
DSKCH←←5	;Used to write into bug file TELLME.001[E,ALS] , .002 etc.
SWP←←3
IFN BOOKMD, {
RPGO←←4		;CHANNEL USED TO WRITE OUT .BKP FILE IN BKPSW MODE
};END BOOKMD

...←←0

;Type of display (kept in cell called DPY)
$TTY ←← 0	;Teletype kludge
$DD  ←←	1	;Datadisk video type display
$III ←←	2	;III Vector type display
IFNDEF MACDWP<MACDWP←←0>	;Disable DWP's macro-implementing code.
;RIGHT HALF FLAGS
REDNLY←←1	;READ ONLY MODE
COPY←←2		;NEED TO DO COPY (← OR →)
DIROK←←4	;HAVE COMPLETE DIR
UPDTXT←←10	;LINE 1 CHANGED - UPDATE DIR AT WRPAGE
WRITE←←20	;SOMETHING CHANGED - NEED TO WRITE IT
EOF←←40		;INPUT EOF DETECTED - DO ANOTHER LOOKUP (LOSING SYSTEM!)
EDDIR←←100	;EDITING THE DIRECTORY PAGE
ARG←←200	;ARG WAS TYPED TO COMMAND
DSPSCR←←400	;REDISPLAY SCREEN
DSPALL←←1000	;REDISPLAY WHOLE SCREEN
FILLUZ←←2000	;EDITING NONSTANDARD FORMAT FILE
REL←←4000	;RELATIVE ARG (+ OR -)
NEG←←10000	;NEGATIVE ARG
EDITM←←20000	;DISPATCH IS FROM LINE EDIT
EDBRK←←40000	;(WITH EDITM) COMMAND TYPED IN MIDDLE OF LINE
XPAGE←←100000	;WILL EXPAND FILE FOR PAGE
UPDIR←←200000	;NON-TEXT CHANGE TO DIR
ATTMOD←←400000	;IN ATTACH MODE

;LEFT HALF FLAGS
ENTRD←←1	;EDIT FILE HAS BEEN ENTERED
CLRBF←←2	;CLEAR OBUF AFTER OUTPUT
NOSHUF←←4	;DON'T SHUFFLE FREE STORAGE
NOCHK←←10	;DON'T TRY TO CORE DOWN
OFFEND←←20	;ARROW ON LINE N+1
NULLIN←←40	;CURRENT LINE IS EMPTY
ARRPG←←100	;ARROW POG IS SELECTED
TF1←←200	;TEMP FLAG
PMLIN←←400	;CURRENT LINE IS PAGE MARK
OKF←←1000	;SHOULD TYPE "OK"
	;New flags added by ALS.
ALIN←←2000		;ALINE FLAG
INDEN←←4000		;INDENT FLAG
CEN←←10000		;CENTER FLAG
JOINF←←20000		;JOIN FLAG
ZATT←←40000		;To save ATTACH on a Z-EPSIL command.
LINSM←←100000		;LINE INSERT MODE
;	200000
NGPUSE←←400000		;Network Graphic User
;CHARACTER TABLE FLAGS
NSPEC←←400000	;STANDARD SPECIAL CHAR (NULL OR RUBOUT) - MUST BE SIGN
FSPC←200000	;FILE NAME DELIMITER
LSPC←←100000	;SPECIAL CHAR IN LINE
NUMF←←40000	;DIGIT
DSPC←←20000	;SPECIAL DIR CHAR
LETF←←10000	;LETTER - WITH LT2F => LOWER CASE
LT2F←←4000	;ALONE => $%._
SSP1←←2000	;TYPE 1 SPECIAL SEARCH STRING CHAR
SSP2←←1000	;  "  2  " ...
EDOK←←40	;RIGHTMOST OF 4 BITS (SHIFT BY CONTROL BITS) FOR LINE EDITOR LEGALITY

;COMMAND DISPATCH FLAGS
NOEDIT←←200000	;DISPATCH DIRECTLY FROM LINE EDIT WITHOUT REPLACING LINE
DOEDIT←←100000	;REPLACE LINE BEFORE DISPATCHING FROM LINE EDIT
		;IF NEITHER OF THE ABOVE, RE-EDIT LINE AT SAME CURSOR POS (CHAR IS NO-OP)
NOATT←←40000	;ILLEGAL IN ATTACH MODE
NORDO←←20000	;ILLEGAL IF READ-ONLY
;10000		;USER MODE BIT MUST BE UNUSED
SACMD←←4000	;USES SEARCH ARG
SSCMD←←2000	;SPECIAL ACTION WHEN ENTERED FROM SEARCH
MSGCMD←←1000	;SPECIAL ACTION WHEN ENTERED FROM MSG COMMAND (PARTIAL SIGN)

LPDESC←←3	;# EXTRA WDS DIR ENTRY
DPBIT←←400000	;DIRPT ENTRY
D1BIT←←200000	;DIRP1 ENTRY
RPMASK←←77	;MASK FOR RELATIVE PAGE # FIELD
RPBYTE←←<220600,,>	;BYTE PNTR FOR ABOVE

EDCHRL←←=126		;Assumed safe display char. count for line editor
			;140 less 2 for CRLF and less 12 for 6 TAB's
EDWRDL←←=33		;Max. words in core per line for line editor (140)/5+5
LLDESC←←3		;# EXTRA WDS TEXT LINE
PMARK←←400000		;THIS LINE IS A PAGE MARK
ARRBIT←←200000		;LINE IS ARRLIN
WINBIT←←100000		;LINE IS WINLIN
PTRBIT←←040000		;LINE IS COMMENT OR REFERENCE POINTER

LOKBIT←←200000	;LOCKS DOWN FS BLOCK (CAN'T BE SHUFFLED)

MAXLIN←←=42
ATTMAX←←8

;Flags used in left half of D in FRD and related file-specification code
FRDNAM←←40		;A new name was typed
FRDEXT←←100		;An extension was typed
FRDPRJ←←200		;A project name was typed
FRDPRN←←400		;A programmer name was typed
FRDDEV←←1000		;A device was specified
FRDTMP←←200000		;TMPCOR has been read and may have to be overruled
;FRDRUN must be sign bit.
FRDRUN←←400000		;Used by XRUN command to get filename without switches
;BITS FOR GETLIN, SETACT, DEVCHR.  S 137 CODE.  SORRYU FATALU

DD←←20000	;RUNNING ON DATA DISK
III←←400000	;  "	 "  III (BITS FROM GETLIN)
PTY←←4000	;  "     "  PTY
IMLIN←←2000	;  "     "  IMLAC
SUPCCR←←2	;BREAK TABLE BIT TO SUPPRESS CTRL1-CR HACK
EMODE←←10	;Break table bit to place 400 after last char when activating
ALLACT←40	;Break table bit to make all ctrl chars and BS active unless re-editing
DVDSK←←200000	;DISK BIT FROM DEVCHR
MININT←←23	;LOWEST INT BIT #
ADRSIZ←←17	;# BITS NEEDED TO ADDRESS PERMANENT CODE

ZZ←←.
LOC 137
IFN PURESW,<
	JRST [	NOESS,<	MOVSI 'E  '	;UPPER NAME ONCE SYSTEMIFIED
		SKIPE JOBDDT↑
		MOVE ['ERAID ']>	;UPPER NAME FOR VERSION WITH RAID
		ESSAY,<	MOVE ['ESSAY ']>
		SETNM2
		JRST 4,137
		MOVE P,[-LPDL+1,,PDL]	;Temp stack for checksum compute
		PUSHJ P,CHKUP		;Check upper segment before setpro
		MOVEM T,CHKSUM
		MOVNI 1
		SETUWP
		JRST 4,137
		MOVSI 155000
		SETPRO
		JRST 4,137
		CALLI 12]
>

IFG DEBSW-PURESW,<
	JRST [	JSP E,PURINI
		CALLI 12]
>

ORG ZZ

FOR @! FOO IN(SORRY,FATAL)
{DEFINE FOO(X)
{	FOO!U [ASCIZ /X/]}
}
;GETCHR GETCH1 GETCH2 FSFIX TSTSHF CW LEG UUOS XOPDEF PURE IMPURE

DEFINE GETCHR(X)
{ILDB C,INPNT
SKIPGE X,CTAB(C)
XCT @CTAB(C)}

DEFINE GETCH1(X)
{ILDB C,INPNT
TDNE X,CTAB(C)
XCT @CTAB(C)}

DEFINE GETCH2(X,Y)
{	ILDB C,Y
	TDNE X,CTAB(C)
	XCT @CTAB(C)}

DEFINE FSFIX(X,Y)
{	HRRI Y,(X)
	SUB Y,FSEND
LEG	MOVEM Y,@FSEND
LEG	HRRZM Y,-1(X)
	HRRZM X,FSEND}

IFN DEBSW{DEFINE TSTSHF
{	SKIPE SHFMOD
	PUSHJ P,MOVIT}}
IFE DEBSW{DEFINE TSTSHF{}}

DEFINE CW(C1,D1,C2,D2,C3,D3){BYTE(8)D1,D2,D3(3)C1,C2,C3,4}

;THESE MACROS MAKE A LINKED LIST AROUND AND THROUGH
;PURE AND UNPURE PARTS FOR CHECKSUMING THE PURE PARTS
;AN ERROR WILL RESULT IF THE SAME MACRO IS CALLED
;TWICE WITHOUT CALLING THE OTHER MACRO.
%SEG←←0
IFE PURESW{
	DEFINE PURE{IFN %SEG{!}	%SEG←←1	PURBEG←←.}
	DEFINE IMPURE{IFE %SEG{!}	%SEG←←0
		PURBEG,,PURLK2↔PURLK2←←.-1
		PURBEG,,PURLNK↔PURLNK←←.-1}
PURLNK←←PURLK2←←0}


;THESE MACROS SET RELOCATION TO THE PROPER SEGMENT FOR PURE OR UNPURE CODE
;AN ERROR MESSAGE WILL RESULT IF THE SAME MACRO IS CALLED TWICE WITHOUT
;CALLING THE OTHER MACRO.
IFN PURESW{
	TWOSEG
	RELOC 400000
	RELOC
	DEFINE PURE{IFN %SEG{!}	%SEG←←1	RELOC}
	DEFINE IMPURE{IFE %SEG{!}	%SEG←←0	RELOC}}


;THIS MACRO SHOULD PRECEDE A LINE OF CODE WHICH CAN
;GENERATE A LEGAL ILL MEM REF.
LEGNUM←←0
DEFINE LEG{FOR @! X←LEGNUM,LEGNUM{LEG!X←←.}	LEGNUM←←LEGNUM+1
}


DEFINE UUOS{FOR @! X IN(TYPCHR,TYPDEC,TYPOCT,SORRYU,FATALU)}

ZZ←←0
UUOS{ZZ←←ZZ+1
OPDEF X[ZZ⊗33]
}

NUUOS←←ZZ+1

EXTERN JOBREL,JOBFF,JOBAPR,JOBTPC,JOBDDT,JOBREN,JOBOPC,JOBCNI
PURE
;BEG BEGSYS BEGACT BEGRPT BEGDBG

IFN DEBSW,<JRST BEGDBG>
	JRST BEGRPT
BEG:	JRST BEG0				;RUN OR ET COMMAND
	JRST BEGRPG				;RPG START. AC'S CONTAIN PARAMS
	MOVEM 16,EPDL				;SYSTEM AXXCOM START
	MOVEM 17,EPDL2				;17[SIXBIT COMMAND, 16[ASCII DELIM
	JSP P,INIT				;INITIALIZE
	MOVE T,EPDL2				;GET COMMAND NAME
	MOVEM T,SYSCMD				;STOW IT
	MOVE A,[440700,,BUF]			;INITIAL BYTE POINTER
	MOVE C,EPDL				;INITIAL CHARACTER IN "SCAN"
;	PUSHJ P,TYIT
;	JRST BEGACT
	INWAIT
	HRLOI T,377777				;SET T INFINITE
	PUSHJ P,RSCN4A				;SCAN REMAINER OF COMMAND FOR ARGS
BEGSYS:	LDB C,[301400,,SYSCMD]			;GET 2 CHARACTERS OF COMMAND NAME
	PUSHJ P,SYSCCK				;DO WE KNOW THEM
	JRST BEG1				;YES. NOW WE READ FILE NAME FROM TTY
	JRST BEG0				;DONT UNDERSTAND COMMAND. RESCAN.

BEGACT:	MOVE T,[440700,,[ASCIZ /
/]]
	MOVEM T,TYIPNT
	JRST BEGSYS

BEGRPT:	JSP P,INIT			;INITIALIZE
	PUSHJ P,TMPRED			;TRY TO READ TMPCORE FILE
	JRST BEG0A
	PUSH P,TYIPNT			;SAVE POINTER TO ARGS
	MOVEM G,TYIPNT			;POINT TO COMMAND
	PUSHJ P,GETNAM			;AND READ IT
	MOVEM A,SYSCMD
	POP P,TYIPNT			;NOW POINT TO ARGS AGAIN
	JRST BEGSYS			;AND LOOK LIKE AXXCOM STARTUP

IFN DEBSW,<
BEGDBG:	JSP P,INIT			;HERE FOR DEBUGGING. INITIALIZE
	INWAIT				;WAIT FOR SOMETHING TO BE TYPED
	HRLOI T,377777			;SET CHARACTER COUNT TO INFINITE
	PUSHJ P,RSCAN0			;READ COMMAND, AVOID RESCAN
	JRST BEG0A			;ACT NORMAL
>
;BEGRPG
;HERE AT RPG STARTUP.

BEGRPG:	MOVEM 17,RPGACS+17
	MOVEI 17,RPGACS
	BLT 17,RPGACS+16		;SAVE RPG PARAMETERS
	JSP P,INIT0			;INITIALIZE
	HRRZ T,RPGLIN
	CAILE T,=999
	SETZB T,RPGLIN
	MOVEM T,SLINE			;STARTING LINE NUMBER
	SKIPGE T,RPGPAG
	MOVEI T,
	MOVEM T,SPAGE			;STARTING PAGE NUMBER
	MOVSI T,'DSK'
	MOVEM T,EDFIL-1			;DEFAULT DEVICE
	SKIPN T,RPGFIL
	EXIT				;NO FILE NAME - NO EDIT.
	MOVEM T,EDFIL			;SAVE EDIT FILE NAME
	SKIPN T,RPGPPN
	MOVE T,PPN
	MOVEM T,EDFIL+3			;EDIT FILE PPN
	MOVE T,RPGEXT
	HLLZM T,EDFIL+1			;EDIT FILE EXT
	SETZM EDFIL+2
	SETZM EDFIL+4
	HRLOI TT,1
	TRNE T,100000			;INSPECT MODE FLAGS
	MOVEM TT,EDFIL+4		;SET /N  NO DIRECTORY
	TRNE T,400000
	SETOM CREASW			;CREATING
	TRNE T,200000
	SETOM RDONLY			;/R READONLY
;TEMPORARY DELETION TO SEE IF IT STOPS SOME TROUBLE JUNE 27,1975
;	PUSHJ P,ZLIST			;SAVE ALL THIS SHINY NEW DATA IN ZDATA
	JFCL
	JRST BEG3

IMPURE
RPGACS:	BLOCK 11			;PLACE TO SAVE RPG PARAMETERS
RPGPPN:	0
	0
RPGEXT:	0
RPGFIL:	0
RPGLIN:	0
RPGPAG:	0
	0
PURE
;BEG0 BEG0.1 BEG0A BEG1 BEGSY2 BEGSY3 BEGSY4 BEG1B BEG1A BEG2 BEGBKP FLOSE FNERR BEGSY1

BEG0:	JSP P,INIT			;INITIALIZE
BEG0.1:	PUSHJ P,RSCAN			;RESCAN TTY
BEG0A:	SKIPN TYIPNT			;WAS THERE ANYTHING THERE?
	OUTSTR [ASCIZ /
FILE? /]		;NO. ASK FOR SOME.
BEG1:	MOVEI D,EDFIL			;POINTER TO DEPOSIT?
	LDB C,[301400,,SYSCMD]		;GET THE COMMAND NAME
	PUSHJ P,CRECHK			;WAS IT CREATE?
	JRST [SETOM CREASW		;YES. SET FLAG
		JRST BEGSY2]	
IFN BOOKMD, {
	CAIN C,'RE'			;"READ" COMMAND?
	JRST BEGBKP			;YES
};END BOOKMD
	JUMPN C,BEGSY1			;WAS IT SOME SORT OF COMMAND AT ALL?
BEGSY2:	PUSHJ P,FRD			;READ FILE NAME (TTY OR RESCANNED DATA)
	JRST FNERR			;OOPS.
BEGSY3:	SKIPN EDFIL
	EXIT			;No file name--forget it
	HLLM D,SRCFIL
	HLLM D,DSTFIL
IFN BOOKMD, {
	SKIPN BKPSW		;"READ" COMMAND USED?
	JRST BEGSY4		;NO
	PUSH P,C
	PUSHJ P,BKPRED		;LOOK FOR <FILENM>.BKP FILE (LIKE RPG FILE)
	POP P,C
	SETOM BOOKSW		;BKPSW IMPLIES BOOKSW
	SETOM RDONLY		;BOOKSW IMPLIES RDONLY
	JRST BEG1A
BEGSY4:
};END BOOKMD
	TLNN D,740		;ANY FILENAME, EXTENSION, OR PPN SPECIFIED?
	JRST BEG1B		;NO
	MOVEI G,(C)
	PUSHJ P,TMPWRT
	LDB C,[301400,,SYSCMD]
	PUSHJ P,CRECHK
	SETOM CREASW
	MOVEI C,(G)
BEG1B:	CAIE C,"←"
	CAIN C,"→"
	TROA F,COPY
	JRST BEG1A
	MOVEM C,TRMCHR#
	MOVEI D,EDFIL2
	PUSHJ P,FRD
	JRST FNERR
	MOVE G,[,SRCFIL-EDFIL2(A)]
	CAIN C,"→"
	HRRI G,DSTFIL-EDFIL2
;	MOVE A,[-5,,EDFIL2]
	MOVE A,[-7,,EDFIL2-2]
	HRRZM A,@G
	AOBJN A,.-1
	HLLM D,EDFIL2(G)
	SKIPN @SRCFIL
	SETOM CREASW
BEG1A:	PUSHJ P,TYIT
	JRST BEG3
BEG2:	PUSHJ P,TYI
	JRST BEG3
	JRST BEG2

FLOSE:	SUB P,[1,,1]
FNERR:	OUTSTR [ASCIZ /ILLEGAL FILE SPECIFICATION./]
	JRST FNF1

IFN BOOKMD, {
BEGBKP:	SETOM BKPSW#	;BKPSW MEANS WE WERE STARTED BY "READ" CMD TO USE .BKP FILE
	SETOM BOOKSW#	;BOOKSW MEANS WE ARE IN /B MODE--NO FILE MODIFYING ALLOWED
};END BOOKMD
BEGSY1:	MOVE H,TYIPNT
	SKIPN TCPNT
	PUSHJ P,TMPRED
	JRST BEGSY2
	PUSHJ P,FRD
	JFCL
	MOVEM H,TYIPNT
	HRLI D,FRDTMP
	PUSHJ P,FRD0
	JRST FNERR
	JRST BEGSY3